home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr51 / lib201.zip / LISTFILE.PRG < prev    next >
Text File  |  1993-03-11  |  14KB  |  340 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program.....: LISTFILE.PRG
  3. *-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
  4. *-- Date........: 03/11/1993
  5. *-- Notes.......: This program/set of routines is designed to display an ASCII
  6. *--               file of up to 1,170 lines, and 254 characters per line
  7. *--               on the screen. ** WARNING ** in dBASE IV, 1.5 -- if you get
  8. *--               close to the 1,170 line limit, you will run out of memory.
  9. *--               (If using version 2.0 or greater, you may be able to read
  10. *--                in 10,000 lines ... the array capabilities allow up to
  11. *--                64K lines (65,535 elements), but I figured that 10000 was
  12. *--                pretty huge ...)
  13. *--               I have not yet figured out how to cope with that.
  14. *--               It allows scrolling (up,down,left,right), and a few hot-keys 
  15. *--               as well:
  16. *--                 <Home>        = the beginning/first character of the line
  17. *--                 <End>         = the right side of a line
  18. *--                 <Ctrl><Home>  = the top of the file
  19. *--                 <Ctrl><End>   = the bottom of the file 
  20. *--                 <PgUp>/<PgDn> = page up/down one screen at a time 
  21. *--                 <Esc>/<Enter> = exit
  22. *-- Rev. History: 01/25/1993 -- Original Release
  23. *--               02/24/1993 -- Minor modifications -- if user sends # of 
  24. *--                             lines that would give a window larger than
  25. *--                             the screen can handle (nMaxLines + nRow > 
  26. *--                             length of screen), we set the max number of
  27. *--                             lines to the length of the screen. Also
  28. *--                             Added <Enter> to exit routine.
  29. *--               03/11/1993 -- Minor change for version 2.0 -- allows up
  30. *--                             to 10,000 lines ... no guarantees on
  31. *--                             whether or not you will run out of memory.
  32. *-- Usage.......: DO ListFile WITH <cFileName>,<nRow>[,<nMaxLines>[,<nTab>[,;
  33. *--                                <cColor>]]]
  34. *-- Example.....: do listfile with "ListFile.PRG",5,18,3,"rg+/g"
  35. *-- Parameters..: cFileName = name of file to list -- include extension and
  36. *--                           path if necessary
  37. *--               nRow      = starting row on screen (top of "window")
  38. *--               nMaxLines = optional -- number of lines to display at one
  39. *--                           time -- if left off, routine will use as manu
  40. *--                           lines as possible from nRow to bottom of screen.
  41. *--               nTab      = optional -- number of spaces to use for tab 
  42. *--                           characters at the beginning of a line. Ignores
  43. *--                           tabs after the first non-tab character in a line
  44. *--                           for speed's sake.
  45. *--               cColor    = optional -- provide color description for window,
  46. *--                           format: Foreground/Background. For example, to
  47. *--                           display the file in a window that has yellow text
  48. *--                           on a green background, the parameter would be:
  49. *--                           "rg+/g"
  50. *-------------------------------------------------------------------------------
  51.  
  52.     parameters cFileName,nRow,nMaxLines,nTab,cColor
  53.     private cWindow,cCursor,nDisplay,nBottom,nLastLine,x,nCount,nKey,;
  54.               nFirstLine,nCurrPos
  55.     
  56.     save screen to sListFile  && save screen description
  57.     cWindow = window()        && store name of any "current" window on screen
  58.     cCursor = set("CURSOR")   && save current cursor state
  59.     set cursor off            && turn it off ...
  60.     activate screen           && activate screen so we can display on TOP
  61.                               &&    of anything there.
  62.     if pCount() > 4           && if user gave us a set of colors to use
  63.         cColor = "COLOR "+cColor  && define memvar with the word "COLOR" in it
  64.     else
  65.         cColor = ""               && otherwise, set to 'nul'
  66.     endif
  67.     
  68.     *-- if user gave a value for nMaxLines, and it's too big, we have
  69.     *-- set nMaxLines to bottom of screen.
  70.     if pCount() => 3  && we have a parameter passed for this
  71.         if set("DISPLAY") # "MONO" .and. set("DISPLAY") # "COLOR"
  72.             nDisplay = val(right(set("DISPLAY"),2))
  73.             if (nMaxLines + nRow) => nDisplay
  74.                 nMaxLines = (nDisplay - 1) - nRow   && if nDisplay gives 25,
  75.                                                     && set to 24, as the screen
  76.                                                     && goes from 0 to 24 ...
  77.             endif
  78.         else
  79.             if (nMaxLines + nRow) > 24
  80.                 nMaxLines = 24 - nRow
  81.             endif
  82.         endif
  83.     endif
  84.     
  85.     *-- if user didn't tell us how many lines to display ...
  86.     if pCount() = 2 && determine # of lines to display on screen ...
  87.         *-- find bottom of screen, and then subtract nRow from that ...
  88.         if set("DISPLAY") # "MONO" .and. set("DISPLAY") # "COLOR"
  89.                   && if we have such displays as EGA25, or VGA50 ...
  90.             nDisplay = val(right(set("DISPLAY"),2))  && get the value of the right
  91.         else                                        && two characters
  92.             nDisplay = 25             && if MONO/COLOR, we have 25 lines possible
  93.         endif
  94.         if set("STATUS") = "ON"    && if status line is on, we have two four
  95.                                    && lines to work with
  96.             nDisplay = nDisplay - 4
  97.         endif
  98.         nMaxLines = (nDisplay - 1) - nRow  && nDisplay - 1 is so we don't
  99.                                            && go beyond last line (EGA25 gives
  100.                                            && 25, but last line is number 24!)
  101.     endif
  102.     
  103.     *-- bottom row of window is based on nMaxLines
  104.     nBottom = nRow + nMaxLines
  105.     
  106.     *-- set default tab if needed ...
  107.     if pCount() < 4       && set default ... notice that if it's 0, that's
  108.                           && not 'undefined'
  109.         nTab = 5
  110.     endif
  111.     
  112.     *-- get the number of lines in the text file
  113.     nLastLine = TextLine(cFileName)   && obtain line number of last line of file
  114.     nVersion  = val(right(version(),3))  && get version #
  115.     if nVersion < 2.0                    && if less than version 2.0
  116.         if nLastLine > 1170               && max lines we can read into array
  117.             nLastLine = 1170               &&  is 1,170
  118.         endif
  119.     else                                 && we have version 2.0 or greater
  120.         if nLastLine > 10000              &&  we can display 10,000 lines
  121.             nLastLine = 10000
  122.         endif
  123.     endif
  124.     
  125.     *-- display a message for user to let them know we haven't just
  126.     *-- disappeared ...
  127.     @11,28 fill to 14,54 color n+/n
  128.     @10,26 to 13,52 double color rg+/gb
  129.     @11,27 say " Reading/Processing File " color rg+/gb
  130.     cLines = space(7)+transform(nLastLine,"99999")+" Lines"+space(7)
  131.     @12,27 say cLines color rg+/gb
  132.     
  133.     *-- get it
  134.     x = AAppend(cFileName,"aFileList")  && put file into array
  135.     
  136.     *-- deal with tabs here
  137.     if nTab # 0
  138.         nCount = 1
  139.         do while nCount < nLastLine
  140.             do while chr(9) $ aFileList[nCount]   && loop while there is a tab    
  141.                                                   && in the line
  142.                 aFileList[nCount] = ;
  143.                     stuff(aFileList[nCount],at(chr(9),aFileList[nCount]),1,;
  144.                           space(nTab))
  145.             enddo
  146.             nCount = nCount + 1
  147.         enddo
  148.     endif
  149.     
  150.     *-- loop and pad each array element with spaces to 254 characters
  151.     nCount = 1
  152.     do while nCount < nLastLine
  153.         aFileList[nCount] = aFileList[nCount]+space(254-len(aFileList[nCount]))
  154.         nCount = nCount + 1
  155.     enddo
  156.     
  157.     *-- remove message
  158.     restore screen from sListFile
  159.     
  160.     *-- define window
  161.     define window wListFile from nRow,0 to nBottom,79 none &cColor.
  162.     activate window wListFile
  163.     
  164.     *-- now that we're here, let's go ...
  165.     nKey = 0         && initialize to something we're not looking for
  166.     nFirstLine = 1   && First line to display out of list ...
  167.     nCurrPos   = 1   && current position in string
  168.     
  169.     *-----------------------------
  170.     *-- here's the actual loop ...
  171.     *-----------------------------
  172.     do while nKey # 27 .and. nKey # 13  && must press <Esc> to exit
  173.         
  174.         *-- display loop
  175.         nCounter = 0
  176.         do while nCounter < nMaxLines
  177.         
  178.             @nCounter,0 say substr(aFileList[nFirstLine+nCounter],nCurrPos,80)
  179.             nCounter = nCounter + 1
  180.         
  181.         enddo
  182.         
  183.         *-- get keypress
  184.         nKey = inkey(0)   && wait for a keypress
  185.         
  186.         *-- if keypress is one of the following, do something with it ...
  187.         do case
  188.             case nKey = 5    && up arrow  = up one row
  189.                 if nFirstLine > 1
  190.                     nFirstLine = nFirstLine - 1
  191.                 endif
  192.             case nKey = 24   && down arrow = down one row
  193.                 if nFirstLine+nMaxLines < nLastLine
  194.                     nFirstLine = nFirstLine + 1
  195.                 endif
  196.             case nKey = 3    && <PgDn>  = down one screen
  197.                 if nFirstLine+nMaxLines < (nLastLine - nMaxLines)
  198.                     nFirstLine = nFirstLine + nMaxLines
  199.                 else
  200.                     nFirstLine = nLastLine - nMaxLines
  201.                 endif
  202.             case nKey = 18   && <PgDn>  = up one screen
  203.                 if nFirstLine - nMaxLines > 1
  204.                     nFirstLine = nFirstLine - nMaxLines
  205.                 else
  206.                     nFirstLine = 1
  207.                 endif
  208.             case nKey = 23   && <Ctrl><End>   = End of File
  209.                 nFirstLine = nLastLine - nMaxLines
  210.             case nKey = 29   && <Ctrl><Home>  = Beginning of File
  211.                 nFirstLine = 1
  212.             case nKey = 19   && <Left> = Back up one character
  213.                 if nCurrPos > 1
  214.                     nCurrPos = nCurrPos - 1
  215.                 endif
  216.             case nKey = 4    && <Right> = Go RIGHT one character
  217.                 if nCurrPos < 174  && 254-80 (width of string - screen width
  218.                     nCurrPos = nCurrPos + 1
  219.                 endif
  220.             case nKey = 2    && <End> = end of line
  221.                 nCurrPos = 174   && show last character(s) on right side of text
  222.             case nKey = 26   && <Home> = beginning of line
  223.                 nCurrPos = 1
  224.         endcase
  225.         
  226.     enddo
  227.     
  228.     *-- if here, we <Esc>aped out of the loop
  229.     deactivate window wListFile
  230.     release window wListFile
  231.     restore screen from sListFile
  232.     release screen sListFile
  233.     if .not. isblank(cWindow)
  234.         activate window &cWindow.
  235.     endif
  236.     release aFileList
  237.     set cursor &cCursor.
  238.     
  239. RETURN
  240. *-- EoP: ListFile
  241.  
  242. FUNCTION AAppend
  243. *-------------------------------------------------------------------------------
  244. *-- Programmer..: Adam L. Menkes (Borland Technical Support)
  245. *-- Date........: 03/11/1993
  246. *-- Notes.......: Appends a text file into an array. This routine is limited to
  247. *--               text files of 1,170 lines, and 254 characters per line.
  248. *--               (Modified by KJM for this routine only to handle up to 10000
  249. *--                lines for version 2.0 of dBASE IV)
  250. *--               The text file must be an ASCII Txt formatted file. Taken from
  251. *--               Technotes, April, 1992.
  252. *-- Written for.: dBASE IV, 1.5
  253. *-- Rev. History: 04/01/1992 -- Original Release
  254. *--               02/24/1993 -- Modified to deal with nLines possibly larger
  255. *--                             than 1170 -- if so, we blow up ... this has
  256. *--                             been fixed.
  257. *--               03/11/1993 -- Version 2.0 of dBASE IV allows up to 64K for
  258. *--                             an array, but I cut it off at 10,000 ...
  259. *-- Calls.......: TextLine()           Function in LOWLEVEL.PRG
  260. *-- Called by...: Any
  261. *-- Usage.......: AAppend(<cFileName>,<aArrayName>)
  262. *-- Example.....: ?AAppend("CONFIG.DB","aConfig")
  263. *-- Returns.....: .T.
  264. *-- Parameters..: cFileName  = Name of DOS Text file to read into array
  265. *--               aArrayName = Name of array to create. If it already exists,
  266. *--                            this array will be destroyed and overwritten.
  267. *-------------------------------------------------------------------------------
  268.  
  269.    parameters cFileName, aArrayName
  270.    private aTArray, nLines, nX, nHandle
  271.  
  272.    *-- assign array name to a temp variable name ...
  273.    aTArray = aArrayName
  274.    *-- if it exists, get rid of it, and then re-define it
  275.    release &aTArray
  276.    public  &aTArray
  277.    nLines = TextLine(cFileName)  && get number of lines
  278.    if val(right(version(0),3)) < 2  && version 2.0 or less
  279.         if nLines > 1170
  280.             nLines = 1170
  281.         endif
  282.     else
  283.         if nLines > 10000
  284.             nLines = 10000
  285.         endif
  286.     endif
  287.    declare &aTArray[min(nLines,10000)]
  288.  
  289.    *-- get file handle
  290.    nHandle = fopen(cFileName)
  291.  
  292.    *-- store the file into the array
  293.    nX = 1
  294.    do while nX <= nLines
  295.       store fgets(nHandle,254) to &aTArray[nX]
  296.       nX = nX + 1
  297.    enddo
  298.  
  299.    *-- close the file
  300.    nHandle = fClose(nHandle)
  301.  
  302. RETURN .T.
  303. *-- EoF: AAppend()
  304.  
  305. FUNCTION TextLine
  306. *-------------------------------------------------------------------------------
  307. *-- Programmer..: Adam L. Menkes (Borland Technical Support)
  308. *-- Date........: 04/01/1992
  309. *-- Notes.......: Returns the number of lines of text in an ASCII Text File
  310. *--               Taken from TechNotes, April, 1992
  311. *-- Written for.: dBASE IV, 1.5
  312. *-- Rev. History: 04/01/1992 -- Original Release
  313. *-- Calls.......: None
  314. *-- Called by...: Any
  315. *-- Usage.......: TextLine(<cTextFile>)
  316. *-- Example.....: ?TextLine("CONFIG.DB")
  317. *-- Returns.....: Number of lines
  318. *-- Parameters..: cTextFile = name of file
  319. *-------------------------------------------------------------------------------
  320.  
  321.    parameter cTextFile
  322.    private nLines, nHandle, cTemp, nClose
  323.  
  324.    nLines = 0
  325.    if file(cTextFile)   && if it exists ...
  326.       nHandle = fopen(cTextFile,"R")
  327.       do while .not. feof(nHandle)
  328.      cTemp = fgets(nHandle,254)
  329.      nLines = nLines + 1
  330.       enddo
  331.       nClose = fclose(nHandle)
  332.    endif
  333.  
  334. RETURN nLines
  335. *-- EoF: TextLine()
  336.  
  337. *-------------------------------------------------------------------------------
  338. *-- End of Program: LISTFILE.PRG
  339. *-------------------------------------------------------------------------------
  340.